home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Src / stk.h < prev    next >
Encoding:
C/C++ Source or Header  |  1996-07-23  |  41.4 KB  |  1,399 lines
  1. /******************************************************************************
  2.  *
  3.  * s t k . h
  4.  *
  5.  * Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  6.  * 
  7.  *
  8.  * Permission to use, copy, and/or distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that both the above copyright notice and this permission notice appear in
  11.  * all copies and derived works.  Fees for distribution or use of this
  12.  * software or derived works may only be charged with express written
  13.  * permission of the copyright holder.  
  14.  * This software is provided ``as is'' without express or implied warranty.
  15.  *
  16.  * This software is a derivative work of other copyrighted softwares; the
  17.  * copyright notices of these softwares are placed in the file COPYRIGHTS
  18.  *
  19.  *
  20.  *           Author: Erick Gallesio [eg@unice.fr]
  21.  *    Creation date: 12-May-1993 10:34
  22.  * Last file update: 23-Jul-1996 16:00
  23.  *
  24.  ******************************************************************************/
  25.  
  26. #ifndef _STK_H
  27. #define _STK_H
  28.  
  29. #ifdef __cplusplus
  30. extern "C" {
  31. #endif
  32.  
  33. #include <stdio.h>
  34. #include <setjmp.h>
  35. #include <assert.h>
  36. #include <math.h>
  37. #include <signal.h>
  38. #include <limits.h>
  39. #include <string.h>
  40. #include <sys/types.h>
  41. #include <errno.h>
  42. #ifndef WIN32
  43. #  include <memory.h>
  44. #endif
  45. #ifdef HAVE_UNISTD_H
  46. #  include <unistd.h>
  47. #endif
  48. #include <stdlib.h>
  49. #include "gmp.h"
  50.  
  51. /*
  52.  * Header <tcl.h> is always included (even if not USE_TK) for the hash table
  53.  * function prototypes. 
  54.  */
  55. #include <tcl.h>
  56.  
  57. /* ------------------------------------------------------------------------------ */
  58.  
  59. #define COMPACT_SMALL_CST            /* compact coding for small const */
  60.  
  61. #define FALSE            0
  62. #define TRUE            1
  63.  
  64. #define TKBUFFERN         1024        /* max size of a token */
  65. #define MAX_CHAR_CODE        255        /* Max code for a char */
  66.  
  67. #ifdef USE_TK
  68. #  define INITIAL_HEAP_SIZE     25000        /* size of heap (in cells) */
  69. #else
  70. #  define INITIAL_HEAP_SIZE     10000        /* size of heap (in cells) */
  71. #endif
  72.  
  73. #ifdef _POSIX_PATH_MAX
  74. #define MAX_PATH_LENGTH     _POSIX_PATH_MAX
  75. #else
  76. #define MAX_PATH_LENGTH     256
  77. #endif
  78.  
  79. #define GC_VERBOSE    "*gc-verbose*"
  80. #define ARGC        "*argc*"
  81. #define ARGV        "*argv*"
  82. #define PROG_NAME    "*program-name*"
  83. #define DEBUG_MODE    "*debug*"
  84. #define EVAL_HOOK    "*eval-hook*"
  85. #define PRINT_BANNER    "*print-banner*"
  86. #define LOAD_PATH    "*load-path*"
  87. #define LOAD_SUFFIXES    "*load-suffixes*"
  88. #define LOAD_VERBOSE    "*load-verbose*"
  89.  
  90. #define REPORT_ERROR    "report-error"
  91.  
  92. #ifdef USE_TK
  93. #    include <tclInt.h>
  94. #    include <tk.h>
  95. #    define ROOT_WINDOW    "*root*"    /* Scheme name of main window */
  96.  
  97.   struct Tk_command {
  98.     ClientData ptr;        /* pointer associated to the widget command */
  99.     Tcl_CmdProc *fct;           /* Tk lib function associated to widget */
  100.     Tcl_CmdDeleteProc *delproc; /* procedure to call when command is destroyed */
  101.     ClientData deldata;           /* value to pass to delproc */
  102.     char Id[1];               /* must be last field */
  103.   };
  104. #endif
  105.  
  106.  
  107. struct obj {
  108.   unsigned char type;
  109.   unsigned char gc_mark;
  110.   unsigned char cell_info;
  111.   union {struct {struct obj * car; struct obj * cdr;}         cons;
  112.      struct {double *data;}                    flonum;
  113.      struct {char *pname; struct obj * vcell;}         symbol;
  114.      struct {char *name; struct obj * (*f)(void);}         subr0;
  115.      struct {char *name; struct obj * (*f)(void *,...);}     subr;
  116.      struct {struct obj *env; struct obj *code;}         closure;
  117.      struct {struct obj *code; }                macro;
  118.      struct {long dim; char *data;}             string;
  119.      struct {long dim; struct obj **data;}             vector;
  120.      struct {struct port_descr *p;}                port;
  121.      struct {char *data;}                     keyword;
  122.      struct {MP_INT *data;}                    bignum;
  123.      struct {short level, position; struct obj *symbol;}    localvar;
  124.      struct {struct obj *expr; int resultknown; }        promise;
  125.      struct {void *data; }                    cont;
  126.      struct {struct obj *data;}                env;
  127.      struct {short id; char staticp; void *data; }        extension;
  128. #ifdef USE_STKLOS
  129.          struct {int id; struct stklos_instance *data; }    instance;
  130. #endif
  131. #ifdef USE_TK
  132.      /* Idea of l_data comes from Alexander Taranov <tay@jet.msk.edu> */
  133.      struct {struct Tk_command *data; struct obj *l_data;}    tk;
  134. #endif
  135.        } storage_as;
  136. };
  137.  
  138. typedef struct obj* SCM;
  139. typedef struct obj* PRIMITIVE;
  140.  
  141.  
  142. #define tc_nil        0
  143. #define tc_cons       1
  144. #define tc_flonum     2
  145. #define tc_integer    3
  146. #define tc_bignum    4
  147. #define tc_symbol     5
  148. #define tc_keyword    6
  149. #define tc_subr_0     7
  150. #define tc_subr_1     8
  151. #define tc_subr_2     9
  152. #define tc_subr_3     10
  153. #define tc_subr_0_or_1  11
  154. #define tc_subr_1_or_2  12
  155. #define tc_subr_2_or_3    13
  156. #define tc_lsubr      14
  157. #define tc_ssubr    15
  158. #define tc_fsubr      16
  159. #define tc_syntax      17
  160. #define tc_closure     18
  161. #define tc_free_cell     19
  162. #define tc_char            20
  163. #define tc_string       21
  164. #define tc_vector    22
  165. #define tc_eof        23
  166. #define tc_undefined    24
  167. #define tc_iport           25
  168. #define tc_oport    26
  169. #define tc_isport    27
  170. #define tc_osport    28
  171. #define tc_boolean    29
  172. #define tc_macro    30
  173. #define tc_localvar    31
  174. #define tc_globalvar    32
  175. #define tc_cont        33
  176. #define tc_env        34
  177. #define tc_address    35
  178. #define tc_autoload    36
  179. #define tc_Cpointer    37
  180.  
  181. #ifdef USE_STKLOS
  182. #  define tc_instance     40
  183. #  define tc_next_method 41
  184. #endif
  185.  
  186. #ifdef USE_TK
  187. #  define tc_tkcommand    50
  188. #endif
  189.  
  190. #define tc_quote    61
  191. #define tc_lambda    62
  192. #define tc_if        63
  193. #define tc_setq        64
  194. #define tc_cond        65 
  195. #define tc_and        66
  196. #define tc_or        67
  197. #define tc_let        68
  198. #define tc_letstar    69
  199. #define tc_letrec    70
  200. #define tc_begin    71
  201. #define tc_promise    72
  202. #define tc_apply    73
  203. #define tc_call_cc    74
  204. #define tc_dynwind    75
  205. #define tc_extend_env   76
  206. #define tc_unbound    80
  207. #define tc_start_extd    90    /* Number of first extended type */
  208. #define tc_stop_extd    127    /* Number of last extended type */
  209.  
  210.  
  211. #define CAR(x)         ((*x).storage_as.cons.car)
  212. #define CDR(x)         ((*x).storage_as.cons.cdr)
  213. #define PNAME(x)     ((*x).storage_as.symbol.pname)
  214. #define KEYVAL(x)    ((*x).storage_as.keyword.data)
  215. #define VCELL(x)     ((*x).storage_as.symbol.vcell)
  216. #define SUBR0(x)     (*((*x).storage_as.subr0.f))
  217. #define SUBRF(x)     (*((*x).storage_as.subr.f))
  218. #define FLONM(x)     (*((*x).storage_as.flonum.data))
  219. #define CHARS(x)    ((*x).storage_as.string.data)
  220. #define STRSIZE(x)    ((*x).storage_as.string.dim)
  221. #define VECT(x)        ((*x).storage_as.vector.data)
  222. #define VECTSIZE(x)    ((*x).storage_as.vector.dim)
  223. #define BIGNUM(x)    ((*x).storage_as.bignum.data)
  224. #define EXTDATA(x)    ((*x).storage_as.extension.data)
  225. #define EXTID(x)    ((*x).storage_as.extension.id)
  226. #define EXTSTATICP(x)    ((*x).storage_as.extension.staticp)
  227.  
  228.  
  229. #ifdef COMPACT_SMALL_CST
  230. #  define MAKE_SMALL_CST(x,type)  (((long) (x) << 8) |((type) << 1) | 1)
  231. #  define SMALL_CST_TYPE(x)      (((long) (x) >> 1) & 0x7F)
  232. #  define SMALL_CST_VALUE(x)      ((long)  (x) >> 8)
  233. #  define SMALL_CSTP(x)          ((long)  (x) & 1)
  234. #  define TYPE(x)          (SMALL_CSTP(x) ? (int)SMALL_CST_TYPE(x):(x)->type)
  235.  
  236. #  define INTEGER(x)          SMALL_CST_VALUE(x)
  237. #  define SET_INTEGER(x, v)      (x = (SCM) MAKE_SMALL_CST(v, tc_integer))
  238. #  define CHAR(x)          ((unsigned char) SMALL_CST_VALUE(x))
  239. #  define SET_CHARACTER(x, v)      (x = (SCM) MAKE_SMALL_CST(v, tc_char))
  240. #else
  241. #  define SMALL_CSTP(x)          FALSE
  242. #  define TYPE(x)          ((x)->type)
  243.  
  244. #  define INTEGER(x)          ((long) ((x)->storage_as.extension.data))
  245. #  define SET_INTEGER(x, v)      (INTEGER(x) = (v))
  246. #  define CHAR(x)          ((unsigned char) ((x)->storage_as.extension.data)
  247. #  define SET_CHARACTER(x, v)      (CHAR(x) = (v))
  248. #endif
  249.  
  250.  
  251. #define EQ(x,y)     ((x) == (y))
  252. #define NEQ(x,y)     ((x) != (y))
  253. #define NULLP(x)     EQ(x,NIL)
  254. #define NNULLP(x)     NEQ(x,NIL)
  255.  
  256. #define TYPEP(x,y)     (TYPE(x) == (y))
  257. #define NTYPEP(x,y)     (TYPE(x) != (y))
  258.  
  259. #define CONSP(x)        TYPEP(x,tc_cons)
  260. #define CLOSUREP(x)     TYPEP(x,tc_closure)
  261. #define FLONUMP(x)      TYPEP(x,tc_flonum)
  262. #define SYMBOLP(x)      TYPEP(x,tc_symbol)
  263. #define KEYWORDP(x)     TYPEP(x,tc_keyword)
  264. #define STRINGP(x)     TYPEP(x,tc_string)
  265. #define EOFP(x)         TYPEP(x, tc_eof)
  266. #define BOOLEANP(x)     TYPEP(x, tc_boolean)
  267. #define VECTORP(x)     TYPEP(x,tc_vector)
  268. #define IPORTP(x)     TYPEP(x,tc_iport)
  269. #define OPORTP(x)     TYPEP(x,tc_oport)
  270. #define ISPORTP(x)     TYPEP(x,tc_isport)
  271. #define OSPORTP(x)     TYPEP(x,tc_osport)
  272. #define INTEGERP(x)     TYPEP(x,tc_integer)
  273. #define BIGNUMP(x)     TYPEP(x,tc_bignum)
  274. #define NUMBERP(x)     (FLONUMP(x) || INTEGERP(x) || BIGNUMP(x))
  275. #define EXACTP(x)     (INTEGERP(x) || BIGNUMP(x))
  276. #define CHARP(x)     TYPEP(x,tc_char)
  277. #define PROMISEP(x)     TYPEP(x,tc_promise)
  278. #define CONTINUATIONP(x) TYPEP(x,tc_cont)
  279. #define ENVP(x)         TYPEP(x,tc_env)
  280. #define MACROP(x)     TYPEP(x,tc_macro)
  281. #define EXTENDEDP(x)     (tc_start_extd <= TYPE(x))
  282. #define CPOINTERP(x)     TYPEP(x,tc_Cpointer)
  283.  
  284. #define NCONSP(x)         NTYPEP(x,tc_cons)
  285. #define NCLOSUREP(x)      NTYPEP(x,tc_closure)
  286. #define NFLONUMP(x)       NTYPEP(x,tc_flonum)
  287. #define NSYMBOLP(x)       NTYPEP(x,tc_symbol)
  288. #define NKEYWORDP(x)      NTYPEP(x,tc_keyword)
  289. #define NSTRINGP(x)      NTYPEP(x,tc_string)
  290. #define NEOFP(x)      NTYPEP(x, tc_eof)
  291. #define NBOOLEANP(x)      NTYPEP(x, tc_boolean)
  292. #define NVECTORP(x)      NTYPEP(x,tc_vector)
  293. #define NIPORTP(x)      NTYPEP(x,tc_iport)
  294. #define NOPORTP(x)      NTYPEP(x,tc_oport)
  295. #define NISPORTP(x)      NTYPEP(x,tc_isport)
  296. #define NOSPORTP(x)      NTYPEP(x,tc_osport)
  297. #define NINTEGERP(x)      NTYPEP(x,tc_integer)
  298. #define NBIGNUMP(x)      NTYPEP(x,tc_bignum)
  299. #define NNUMBERP(x)      (NFLONUMP(x) && NINTEGERP(x) && NBIGNUMP(x))
  300. #define NEXACTP(x)      (NINTEGERP(x) && NBIGNUMP(x))
  301. #define NCHARP(x)      NTYPEP(x,tc_char)
  302. #define NPROMISEP(x)      NTYPEP(x,tc_promise)
  303. #define NCONTINUATIONP(x) NTYPEP(x,tc_cont)
  304. #define NENVP(x)      NTYPEP(x,tc_env)
  305. #define NMACROP(x)      NTYPEP(x,tc_macro)
  306. #define NEXTENDEDP(x)      (!EXTENDEDP(x))
  307. #define NCPOINTERP(x)      NTYPEP(x,tc_Cpointer)
  308.  
  309. #ifdef USE_TK
  310. #  define TKCOMMP(x)      TYPEP(x,tc_tkcommand)
  311. #  define NTKCOMMP(x)      NTYPEP(x,tc_tkcommand)
  312. #endif
  313.  
  314. #define ModifyCode()    NEQ(VCELL(STk_sym_debug), STk_truth)
  315.  
  316. #define SYNTAX_RETURN(x, need_eval) \
  317.               { *pform = (x); return (need_eval); }
  318.  
  319.  
  320. #ifdef _DEBUG_MALLOC_INC
  321. #define must_malloc(n)        malloc(n)
  322. #define must_realloc(p, n)    realloc(p, n)
  323. #endif
  324.  
  325.  
  326. #define CELL_INFO_C_VAR     01    /* Symbol is a C variable */
  327. #define CELL_INFO_TRACED_VAR    02    /* Symbol is traced */
  328.  
  329.  
  330.  
  331. #define TRACED_VARP(var)    (((var)->cell_info) & CELL_INFO_TRACED_VAR)
  332.  
  333.  
  334. #define Debug(message, obj) {fprintf(STk_stderr, "***%s",message); \
  335.                  STk_print(obj, STk_curr_eport, WRT_MODE); \
  336.                  fprintf(STk_stderr, "\n");}
  337. #define TRACE(message)    {printf("In %s (%d):", __FILE__, __LINE__); \
  338.              printf message; putchar('\n');}
  339.  
  340.  
  341. /******************************************************************************/
  342. /******************************************************************************/
  343. /******************************************************************************/
  344. /******************************************************************************/
  345.  
  346. /*
  347.   ------------------------------------------------------------------------------
  348.   ----
  349.   ----  A D D R E S S . C
  350.   ----
  351.   ------------------------------------------------------------------------------
  352. */
  353. SCM       STk_address2object(char *buffer);
  354.  
  355. PRIMITIVE STk_address_of(SCM obj);
  356. PRIMITIVE STk_addressp(SCM address);
  357.  
  358. /*
  359.   ------------------------------------------------------------------------------
  360.   ----
  361.   ----  A R G V . C
  362.   ----
  363.   ------------------------------------------------------------------------------
  364. */
  365. #ifdef USE_TK
  366. extern char *STk_arg_Xdisplay;
  367. extern char *STk_arg_geometry;
  368. extern char *STk_arg_name;
  369. extern char *STk_arg_visual;
  370. extern int   STk_arg_colormap;
  371. extern int   STk_arg_sync;
  372. extern int   STk_arg_no_tk;
  373. #endif
  374. extern char *STk_arg_file;
  375. extern char *STk_arg_load;
  376. extern char *STk_arg_cells;
  377. extern char *STk_arg_image;
  378. extern int   STk_arg_interactive;
  379.  
  380. char** STk_process_argc_argv(int argc, char **argv);
  381. void   STk_save_unix_args_and_environment(int argc, char **argv);
  382. void   STk_restore_unix_args_and_environment(int *argc, char ***argv);
  383. void   STk_initialize_scheme_args(char **argv);
  384.  
  385.  
  386. /*
  387.   ------------------------------------------------------------------------------
  388.   ----
  389.   ----  B O O L E A N . C
  390.   ----
  391.   ------------------------------------------------------------------------------
  392. */
  393. PRIMITIVE STk_not(SCM x);
  394. PRIMITIVE STk_booleanp(SCM x);
  395. PRIMITIVE STk_eqv(SCM x, SCM y);
  396. PRIMITIVE STk_eq(SCM x,SCM y);
  397. PRIMITIVE STk_equal(SCM x, SCM y);
  398.  
  399.  
  400. /*
  401.   ------------------------------------------------------------------------------
  402.   ----
  403.   ----  C H A R . C
  404.   ----
  405.   ------------------------------------------------------------------------------
  406. */
  407. char  STk_string2char(char *s);
  408. char *STk_char2string(char c);
  409. SCM   STk_makechar(char c);
  410.  
  411. PRIMITIVE STk_charp(SCM obj);
  412.  
  413. PRIMITIVE STk_chareq   (SCM c1, SCM c2);
  414. PRIMITIVE STk_charless (SCM c1, SCM c2);
  415. PRIMITIVE STk_chargt   (SCM c1, SCM c2);
  416. PRIMITIVE STk_charlesse(SCM c1, SCM c2);
  417. PRIMITIVE STk_chargte  (SCM c1, SCM c2);
  418.  
  419. PRIMITIVE STk_chareqi   (SCM c1, SCM c2);
  420. PRIMITIVE STk_charlessi (SCM c1, SCM c2);
  421. PRIMITIVE STk_chargti   (SCM c1, SCM c2);
  422. PRIMITIVE STk_charlessei(SCM c1, SCM c2);
  423. PRIMITIVE STk_chargtei  (SCM c1, SCM c2);
  424.  
  425. PRIMITIVE STk_char_alphap(SCM c);
  426. PRIMITIVE STk_char_numericp(SCM c);
  427. PRIMITIVE STk_char_whitep(SCM c);
  428. PRIMITIVE STk_char_upperp(SCM c);
  429. PRIMITIVE STk_char_lowerp(SCM c);
  430. PRIMITIVE STk_char2integer(SCM c);
  431. PRIMITIVE STk_integer2char(SCM i);
  432. PRIMITIVE STk_char_upper(SCM c);
  433. PRIMITIVE STk_char_lower(SCM c);
  434.  
  435. /*
  436.   ------------------------------------------------------------------------------
  437.   ----
  438.   ----  C O N T . C
  439.   ----
  440.   ------------------------------------------------------------------------------
  441. */
  442. SCM       STk_mark_continuation(SCM cont);
  443. void       STk_throw(SCM fct, SCM val);
  444. SCM       STk_do_call_cc(SCM *x);
  445. PRIMITIVE STk_continuationp(SCM obj);
  446.  
  447. void       STk_unwind_all(void);
  448. PRIMITIVE STk_dynamic_wind(SCM thunk1, SCM thunk2, SCM thunk3);
  449.  
  450. /*
  451.   ------------------------------------------------------------------------------
  452.   ----
  453.   ----  D U M P . C
  454.   ----
  455.   ------------------------------------------------------------------------------
  456. */
  457. extern int STk_dumped_core;
  458. void STk_restore_image(char *s);
  459. PRIMITIVE STk_dump(SCM s);
  460.  
  461.  
  462. /*
  463.   ------------------------------------------------------------------------------
  464.   ----
  465.   ----  D Y N L O A D . C
  466.   ----
  467.   ------------------------------------------------------------------------------
  468. */
  469. void STk_load_object_file(char *path);
  470.  
  471.  
  472. /*
  473.   ------------------------------------------------------------------------------
  474.   ----
  475.   ----  E N V . C
  476.   ----
  477.   ------------------------------------------------------------------------------
  478. */
  479. #define STk_fast_extend_env(formals, actuals, env) \
  480.     Cons(Cons((formals), (actuals)), (env))
  481.  
  482. SCM STk_makeenv(SCM l, int create_if_null);
  483. SCM *STk_value_in_env(SCM var, SCM env);
  484. SCM *STk_varlookup(SCM x, SCM env, int err_if_unbound);
  485. SCM STk_localvalue(SCM var, SCM env);
  486. SCM STk_extend_env(SCM formals, SCM actuals, SCM env, SCM who);
  487.  
  488. PRIMITIVE STk_symbol_boundp(SCM x, SCM env);
  489. PRIMITIVE STk_the_environment(SCM args, SCM env, int len);
  490. PRIMITIVE STk_parent_environment(SCM env);
  491. PRIMITIVE STk_global_environment(void);
  492. PRIMITIVE STk_environment2list(SCM env);
  493. PRIMITIVE STk_environmentp(SCM obj);
  494.  
  495.  
  496. /*
  497.   ------------------------------------------------------------------------------
  498.   ----
  499.   ----  E R R O R . C
  500.   ----
  501.   ------------------------------------------------------------------------------
  502. */
  503.  
  504. #define EVAL_ERROR        ((SCM) 1)
  505.  
  506. #define ERR_FATAL        000
  507. #define ERR_OK            001
  508. #define ERR_READ_FROM_STRING    002
  509. #define ERR_IGNORED        004
  510. #define ERR_TCL_BACKGROUND    010
  511.  
  512. #define JMP_INIT        0
  513. #define JMP_ERROR        1
  514. #define JMP_THROW        2
  515. #define JMP_RESTORE        3
  516.  
  517. extern jmp_buf *STk_top_jmp_buf; /* Jump buffer denoting toplevel context */
  518. extern long STk_error_context;
  519.  
  520. void STk_err(char *message, SCM x);
  521.  
  522. #define Err         STk_err
  523. #define err        STk_err    /* For compatibility: don't use it anymore */
  524. #define Top_jmp_buf    STk_top_jmp_buf
  525. #define Error_context    STk_error_context
  526. /*
  527.   ------------------------------------------------------------------------------
  528.   ----
  529.   ----  E V A L . C
  530.   ----
  531.   ------------------------------------------------------------------------------
  532. */
  533.  
  534. /* The eval flag which tells eval that it has something to do before
  535.  * evaluating the form
  536.  */
  537. extern int STk_eval_flag;
  538.  
  539. /* Eval stack. These are internals of the evaluator. Don't care*/
  540. void STk_show_eval_stack(int depth);
  541. void STk_reset_eval_stack(void);
  542. PRIMITIVE STk_get_eval_stack(void);
  543.  
  544. /* Eval hook management */
  545. void STk_init_eval_hook(void);
  546. void STk_reset_eval_hook(void);
  547. PRIMITIVE STk_eval_hook(SCM x, SCM env, SCM hook);
  548.  
  549. /* Environment stack. These are internals of the evaluator. Don't care*/
  550. SCM STk_top_env_stack(void);
  551. PRIMITIVE STk_get_env_stack(void);
  552.  
  553. SCM STk_eval(SCM x,SCM env);
  554. SCM STk_apply(SCM fct, SCM param);
  555.  
  556. PRIMITIVE STk_user_eval  (SCM expr, SCM env);
  557. PRIMITIVE STk_eval_string(SCM str, SCM env);
  558.  
  559. #define Apply          STk_apply
  560. #define EVAL(x)            (STk_eval((x), env))
  561. #define EVALCAR(x)      (SYMBOLP(CAR(x)) ? *STk_varlookup((x),env,1):EVAL(CAR(x)))
  562. #define SET_EVAL_FLAG(v)  {STk_eval_flag = (v);}
  563.  
  564. /*
  565.   ------------------------------------------------------------------------------
  566.   ----
  567.   ----  E X T E N D  . C
  568.   ----
  569.   ------------------------------------------------------------------------------
  570. */
  571. #define EXT_ISPROC     01    /* procedure? should answer #t */
  572. #define EXT_EVALPARAM     02    /* evaluates parameter list when apply */
  573.  
  574. #define STk_set_symbol_value(name,value)  {VCELL(Intern(name))=(value);}
  575. #define STk_get_symbol_value(name)      (VCELL(Intern(name)))
  576.  
  577. typedef struct {
  578.   char *type_name;        /* The external name of this type */
  579.   int  flags;            
  580.   void (*gc_mark_fct)(SCM x);
  581.   void (*gc_sweep_fct)(SCM x);
  582.   SCM  (*apply_fct)(SCM x, SCM args, SCM env);
  583.   void (*display_fct)(SCM x, SCM port, int mode);
  584.   SCM  (*compare_fct)(SCM x, SCM y, int equalp);
  585.   void *Reserved[7];        /* should be sufficient for a while */
  586. } STk_extended_scheme_type;
  587.  
  588.  
  589. int  STk_add_new_type(STk_extended_scheme_type *p);
  590. void STk_add_new_primitive(char *fct_name, int fct_type, PRIMITIVE (*fct_ptr)());
  591. SCM  STk_eval_C_string(char *s, SCM env);
  592.  
  593. int STk_new_Cpointer_id(void (*display_func)(SCM x, SCM port, int mode));
  594. SCM STk_make_Cpointer(int Cpointer_id, void *ptr, int staticp);
  595.  
  596. void STk_define_C_variable(char *var, SCM (*getter)(), void (*setter)());
  597.  
  598. /*
  599.   ------------------------------------------------------------------------------
  600.   ----
  601.   ----  G C . C
  602.   ----
  603.   ------------------------------------------------------------------------------
  604. */
  605. extern SCM  STk_freelist;
  606. extern long STk_alloc_cells;
  607. extern int  STk_gc_requested;
  608.  
  609. #define NEWCELL(_into,_type)                \
  610.  {                             \
  611.    if (STk_gc_requested || NULLP(STk_freelist))        \
  612.       STk_gc_for_newcell();                \
  613.    _into           = STk_freelist;            \
  614.    STk_freelist       = CDR(STk_freelist);        \
  615.    STk_alloc_cells   += 1;                \
  616.    _into->type        = _type;                \
  617.  }
  618.  
  619. void STk_gc_for_newcell(void);
  620. void STk_gc_protect(SCM *location);   /* protect against GC this cell */
  621. void STk_gc_unprotect(SCM *location); /* un-protect against GC this cell */
  622. void STk_gc_mark(SCM location);       /* mark (recursively) this location */
  623.  
  624. PRIMITIVE STk_gc_stats(void);                /* + */
  625. PRIMITIVE STk_gc(void);                    /* + */
  626. PRIMITIVE STk_find_cells(SCM type);            /* + */
  627. PRIMITIVE STk_expand_heap(SCM arg);            /* + */
  628.  
  629. /*
  630.   ------------------------------------------------------------------------------
  631.   ----
  632.   ----  I O . C
  633.   ----
  634.   ------------------------------------------------------------------------------
  635. */
  636.  
  637. #ifdef WIN32
  638.    extern FILE *STk_stdin, *STk_stdout, *STk_stderr;
  639. #else
  640. #  define STk_stdin  stdin
  641. #  define STk_stdout stdout
  642. #  define STk_stderr stderr
  643. #endif
  644.  
  645. void   STk_StdinProc(void);
  646. int    STk_getc(FILE *f);
  647. int    STk_ungetc(int c, FILE *f);
  648. int    STk_putc(int c, FILE *f);
  649. int    STk_puts(char *s, FILE *f);
  650. int    STk_eof(FILE *f);
  651. char * STk_line_bufferize_io(FILE *f);
  652.  
  653. #ifdef WIN32
  654. void   STk_init_io(void);
  655. #endif
  656.  
  657. #define Getc(f)         (STk_getc(f))
  658. #define Ungetc(c, f)    (STk_ungetc((c), (f)))
  659. #define Putc(c, f)      (STk_putc((c),   (f)))
  660. #define Puts(s, f)      (STk_puts((s),   (f)))
  661. #define Eof(f)        (STk_eof(f))
  662.  
  663.  
  664. /*
  665.   ------------------------------------------------------------------------------
  666.   ----
  667.   ----  K E Y W O R D . C
  668.   ----
  669.   ------------------------------------------------------------------------------
  670. */
  671. void STk_initialize_keyword_table(void);
  672. void STk_free_keyword(SCM keyword);
  673.  
  674. SCM STk_makekey(char *token);
  675. PRIMITIVE STk_make_keyword(SCM str);
  676. PRIMITIVE STk_keywordp(SCM obj);
  677. PRIMITIVE STk_keyword2string(SCM obj);
  678. PRIMITIVE STk_get_keyword(SCM key, SCM l, SCM default_value);
  679.  
  680. /*
  681.   ------------------------------------------------------------------------------
  682.   ----
  683.   ---- L I S T . C
  684.   ----
  685.   ------------------------------------------------------------------------------
  686. */
  687. int STk_llength(SCM l);    /* length of a list. -1 if not a proper list */
  688.  
  689. PRIMITIVE STk_pairp(SCM x);
  690. PRIMITIVE STk_cons(SCM x, SCM y);
  691. PRIMITIVE STk_car(SCM x);
  692. PRIMITIVE STk_cdr(SCM x);
  693. PRIMITIVE STk_setcar(SCM cell, SCM value);
  694. PRIMITIVE STk_setcdr(SCM cell, SCM value);
  695. PRIMITIVE STk_caar  (SCM l);
  696. PRIMITIVE STk_cdar  (SCM l);
  697. PRIMITIVE STk_cadr  (SCM l);
  698. PRIMITIVE STk_cddr  (SCM l);
  699. PRIMITIVE STk_caaar (SCM l);
  700. PRIMITIVE STk_cdaar (SCM l);
  701. PRIMITIVE STk_cadar (SCM l);
  702. PRIMITIVE STk_cddar (SCM l);
  703. PRIMITIVE STk_caadr (SCM l);
  704. PRIMITIVE STk_cdadr (SCM l);
  705. PRIMITIVE STk_caddr (SCM l);
  706. PRIMITIVE STk_cdddr (SCM l);
  707. PRIMITIVE STk_caaaar(SCM l);
  708. PRIMITIVE STk_cdaaar(SCM l);
  709. PRIMITIVE STk_cadaar(SCM l);
  710. PRIMITIVE STk_cddaar(SCM l);
  711. PRIMITIVE STk_caadar(SCM l);
  712. PRIMITIVE STk_cdadar(SCM l);
  713. PRIMITIVE STk_caddar(SCM l);
  714. PRIMITIVE STk_cdddar(SCM l);
  715. PRIMITIVE STk_caaadr(SCM l);
  716. PRIMITIVE STk_cdaadr(SCM l);
  717. PRIMITIVE STk_cadadr(SCM l);
  718. PRIMITIVE STk_cddadr(SCM l);
  719. PRIMITIVE STk_caaddr(SCM l);
  720. PRIMITIVE STk_cdaddr(SCM l);
  721. PRIMITIVE STk_cadddr(SCM l);
  722. PRIMITIVE STk_cddddr(SCM l);
  723. PRIMITIVE STk_nullp (SCM x);
  724. PRIMITIVE STk_listp (SCM x);
  725. PRIMITIVE STk_list  (SCM l, int len);
  726. PRIMITIVE STk_list_length(SCM l);
  727. PRIMITIVE STk_append(SCM l, int len);
  728. PRIMITIVE STk_reverse(SCM l);
  729. PRIMITIVE STk_list_tail(SCM list, SCM k);
  730. PRIMITIVE STk_list_ref(SCM list, SCM k);
  731. PRIMITIVE STk_memq  (SCM obj, SCM list);
  732. PRIMITIVE STk_memv  (SCM obj, SCM list);
  733. PRIMITIVE STk_member(SCM obj, SCM list);
  734. PRIMITIVE STk_assq  (SCM obj, SCM alist);
  735. PRIMITIVE STk_assv  (SCM obj, SCM alist);
  736. PRIMITIVE STk_assoc (SCM obj, SCM alist);
  737.  
  738. PRIMITIVE STk_liststar(SCM l, int len);        /* + */
  739. PRIMITIVE STk_copy_tree(SCM l);            /* + */
  740.  
  741. #define Cons             STk_cons
  742. #define Reverse             STk_reverse
  743. #define LIST1(a)         Cons((a), NIL)
  744. #define LIST2(a,b)          Cons((a), LIST1(b))
  745. #define LIST3(a,b,c)         Cons((a), LIST2((b),(c)))
  746. #define LIST4(a,b,c,d)         Cons((a), LIST3((b),(c),(d)))
  747. #define LIST5(a,b,c,d,e)     Cons((a), LIST4((b),(c),(d),(e)))
  748. #define LIST6(a,b,c,d,e,f)     Cons((a), LIST5((b),(c),(d),(e),(f)))
  749. #define LIST7(a,b,c,d,e,f,g)     Cons((a), LIST6((b),(c),(d),(e),(f),(g)))
  750. #define LIST8(a,b,c,d,e,f,g,h)     Cons((a), LIST7((b),(c),(d),(e),(f),(g),(h)))
  751. #define LIST9(a,b,c,d,e,f,g,h,i) Cons((a), LIST8((b),(c),(d),(e),(f),(g),(h),(i)))
  752.  
  753. /*
  754.   ------------------------------------------------------------------------------
  755.   ----
  756.   ---- M A C R O . C
  757.   ----
  758.   ------------------------------------------------------------------------------
  759. */
  760. PRIMITIVE STk_macro(SCM args, SCM env, int len);        /* + */
  761. PRIMITIVE STk_macro_expand(SCM form, SCM env, int len);        /* + */
  762. PRIMITIVE STk_macro_expand_1(SCM form, SCM env, int len);    /* + */
  763. PRIMITIVE STk_macro_body(SCM form);                /* + */
  764. PRIMITIVE STk_macrop(SCM obj);                    /* + */
  765.  
  766. /*
  767.   ------------------------------------------------------------------------------
  768.   ----
  769.   ---- N U M B E R  . C
  770.   ----
  771.   ------------------------------------------------------------------------------
  772. */
  773. #ifdef COMPACT_SMALL_CST
  774. #  define SMALLINT_MAX    (LONG_MAX>>8)
  775. #else
  776. #  define SMALLINT_MAX  LONG_MAX
  777. #endif
  778. #define SMALLINT_MIN    (-SMALLINT_MAX)
  779.  
  780. char   *STk_number2Cstr(SCM n, long base, char buffer[]);
  781. SCM    STk_Cstr2number(char *str, long base);
  782. SCM    STk_makenumber(double x);
  783. SCM    STk_makeinteger(long x);
  784. long    STk_integer_value(SCM x); /* Returns LONG_MIN if not representable as int */
  785. long    STk_integer_value_no_overflow(SCM x); /* Returns LONG_MIN if not an int */
  786. int    STk_equal_numbers(SCM number1, SCM number2); /* number1 = number2 */
  787.  
  788. PRIMITIVE STk_numberp(SCM x);
  789. PRIMITIVE STk_integerp(SCM x);
  790.     
  791. PRIMITIVE STk_exactp(SCM x);
  792. PRIMITIVE STk_inexactp(SCM x);
  793.  
  794. PRIMITIVE STk_numequal(SCM l, SCM env, int from_eval);
  795. PRIMITIVE STk_lessp(SCM l, SCM env, int from_eval);
  796. PRIMITIVE STk_greaterp(SCM l, SCM env, int from_eval);
  797. PRIMITIVE STk_lessep(SCM l, SCM env, int from_eval);
  798. PRIMITIVE STk_greaterep(SCM l, SCM env, int from_eval);
  799.  
  800. PRIMITIVE STk_zerop(SCM n);
  801. PRIMITIVE STk_positivep(SCM n);
  802. PRIMITIVE STk_negativep(SCM n);
  803. PRIMITIVE STk_oddp(SCM n);
  804. PRIMITIVE STk_evenp(SCM n);
  805.  
  806. PRIMITIVE STk_max(SCM l, SCM env, int from_eval);
  807. PRIMITIVE STk_min(SCM l, SCM env, int from_eval);
  808.  
  809. PRIMITIVE STk_plus(SCM l, SCM env, int from_eval);
  810. PRIMITIVE STk_difference(SCM l, SCM env, int from_eval);
  811. PRIMITIVE STk_times(SCM l, SCM env, int from_eval);
  812. PRIMITIVE STk_division(SCM l, SCM env, int from_eval);
  813.  
  814. PRIMITIVE STk_absolute(SCM x);
  815. PRIMITIVE STk_quotient(SCM n1, SCM n2);
  816. PRIMITIVE STk_remainder(SCM n1, SCM n2);
  817. PRIMITIVE STk_modulo(SCM n1, SCM n2);
  818.  
  819. PRIMITIVE STk_gcd(SCM l, SCM env, int from_eval);
  820. PRIMITIVE STk_lcm(SCM l, SCM env, int from_eval);
  821.  
  822. PRIMITIVE STk_floor(SCM x);
  823. PRIMITIVE STk_ceiling(SCM x);
  824. PRIMITIVE STk_truncate(SCM x);
  825. PRIMITIVE STk_round(SCM x);
  826.  
  827. PRIMITIVE STk_exp(SCM z);
  828. PRIMITIVE STk_log(SCM z);
  829. PRIMITIVE STk_sin(SCM z);
  830. PRIMITIVE STk_cos(SCM z);
  831. PRIMITIVE STk_tan(SCM z);
  832. PRIMITIVE STk_asin(SCM z);
  833. PRIMITIVE STk_acos(SCM z);
  834. PRIMITIVE STk_atan(SCM y, SCM x);
  835. PRIMITIVE STk_sqrt(SCM z);
  836. PRIMITIVE STk_expt(SCM z1, SCM z2);
  837.  
  838. PRIMITIVE STk_exact2inexact(SCM z);
  839. PRIMITIVE STk_inexact2exact(SCM z);
  840. PRIMITIVE STk_string2number(SCM str, SCM base);
  841. PRIMITIVE STk_number2string(SCM n, SCM base);
  842.  
  843. PRIMITIVE  STk_bignump(SCM n);
  844.  
  845. /*
  846.   ------------------------------------------------------------------------------
  847.   ----
  848.   ---- P O R T . C
  849.   ----
  850.   ------------------------------------------------------------------------------
  851. */
  852.  
  853. struct port_descr {        /* Slot order is important (see sport_descr) */
  854.   FILE *file;
  855.   int  flags;
  856.   char *filename;
  857.   SCM  read_event;
  858.   SCM  write_event;
  859. };
  860.  
  861. #define PORT_FILE(x)    ((x)->storage_as.port.p->file)
  862. #define PORT_NAME(x)    ((x)->storage_as.port.p->filename)
  863. #define PORT_FLAGS(x)    ((x)->storage_as.port.p->flags)
  864. #define PORT_REVENT(x)    ((x)->storage_as.port.p->read_event)
  865. #define PORT_WEVENT(x)    ((x)->storage_as.port.p->write_event)
  866.  
  867. #define PORT_CLOSED     01
  868. #define PIPE_PORT    02
  869.  
  870.  
  871. #define OUTP(p)     (OPORTP(p) || OSPORTP(p))
  872. #define INP(p)      (IPORTP(p) || ISPORTP(p))
  873. #define F_READ      01
  874. #define F_WRITE     02
  875.  
  876. /* external vars */
  877. extern SCM STk_curr_iport, STk_curr_oport, STk_curr_eport, STk_eof_object;
  878.  
  879.  
  880. void       STk_freeport(SCM port);
  881. void       STk_init_standard_ports(void);
  882. SCM       STk_loadfile(char *fname, int err_if_absent);
  883. SCM       STk_Cfile2port(char *name, FILE *f, int type, int flags);
  884.  
  885. PRIMITIVE STk_input_portp(SCM port);
  886. PRIMITIVE STk_output_portp(SCM port);
  887. PRIMITIVE STk_current_input_port(void);
  888. PRIMITIVE STk_current_output_port(void);
  889. PRIMITIVE STk_current_error_port(void);
  890. PRIMITIVE STk_with_input_from_file(SCM string, SCM thunk);
  891. PRIMITIVE STk_with_output_to_file(SCM string, SCM thunk);
  892. PRIMITIVE STk_open_input_file(SCM filename);
  893. PRIMITIVE STk_open_output_file(SCM filename);
  894. PRIMITIVE STk_close_input_port(SCM port);
  895. PRIMITIVE STk_close_output_port(SCM port);
  896. PRIMITIVE STk_read(SCM port);
  897. PRIMITIVE STk_read_char(SCM port);
  898. PRIMITIVE STk_peek_char(SCM port);
  899. PRIMITIVE STk_eof_objectp(SCM obj);
  900. PRIMITIVE STk_char_readyp(SCM port);
  901. PRIMITIVE STk_write(SCM expr, SCM port);
  902. PRIMITIVE STk_display(SCM expr, SCM port);
  903. PRIMITIVE STk_newline(SCM port);
  904. PRIMITIVE STk_write_char(SCM c, SCM port);
  905. PRIMITIVE STk_scheme_load(SCM filename);
  906.  
  907. /* Non standard functions */
  908. PRIMITIVE STk_format(SCM l, int len);
  909. PRIMITIVE STk_error(SCM l, int len);
  910. PRIMITIVE STk_try_load(SCM filename);
  911. PRIMITIVE STk_open_file(SCM filename, SCM mode);
  912. PRIMITIVE STk_close_port(SCM port);
  913. PRIMITIVE STk_read_line(SCM port);
  914. PRIMITIVE STk_flush(SCM porSTk_t);
  915.  
  916. void      STk_do_autoload(SCM var);
  917. PRIMITIVE STk_autoload(SCM l, SCM env, int len);
  918. PRIMITIVE STk_autoloadp(SCM l, SCM env, int len);
  919.  
  920. PRIMITIVE STk_when_port_readable(SCM port, SCM closure);
  921. PRIMITIVE STk_when_port_writable(SCM port, SCM closure);
  922.  
  923. /*
  924.   ------------------------------------------------------------------------------
  925.   ----
  926.   ---- P R I M I T I V E S . C
  927.   ----
  928.   ------------------------------------------------------------------------------
  929. */
  930. void STk_init_primitives(void);
  931.  
  932. /*
  933.   ------------------------------------------------------------------------------
  934.   ----
  935.   ---- P R I N T . C
  936.   ----
  937.   ------------------------------------------------------------------------------
  938. */
  939. #define DSP_MODE    01
  940. #define WRT_MODE    02
  941. #define TK_MODE        04    /* Always defined even if no Tk support */
  942.  
  943.  
  944. SCM STk_print(SCM exp, SCM port, int mode);
  945.  
  946. /*
  947.   ------------------------------------------------------------------------------
  948.   ----
  949.   ---- P R O C . C
  950.   ----
  951.   ------------------------------------------------------------------------------
  952. */
  953. #define CLOSURE_PARAMETERS(p)        (CAR((p)->storage_as.closure.code))
  954.  
  955. int       STk_is_thunk(SCM obj);
  956. PRIMITIVE STk_procedurep(SCM obj);
  957. PRIMITIVE STk_map(SCM l, int len);
  958. PRIMITIVE STk_for_each(SCM l, int len);
  959. PRIMITIVE STk_procedure_body(SCM proc);
  960. PRIMITIVE STk_procedure_environment(SCM proc);
  961.  
  962. /*
  963.   ------------------------------------------------------------------------------
  964.   ----
  965.   ---- P R O M I S E . C
  966.   ----
  967.   ------------------------------------------------------------------------------
  968. */
  969. PRIMITIVE STk_force(SCM promise);
  970. PRIMITIVE STk_promisep(SCM promise);
  971.  
  972.  
  973. /*
  974.   ------------------------------------------------------------------------------
  975.   ----
  976.   ---- R E A D . C
  977.   ----
  978.   ------------------------------------------------------------------------------
  979. */
  980. SCM STk_readf(FILE *f, int case_significant);
  981.  
  982.  
  983. /*
  984.   ------------------------------------------------------------------------------
  985.   ----
  986.   ---- S I G N A L . C
  987.   ----
  988.   ------------------------------------------------------------------------------
  989. */
  990. #define MAX_SYSTEM_SIG         32            /* True for all systems? */
  991. #define SIGHADGC        MAX_SYSTEM_SIG        /* End of a GC run */
  992. #define MAX_SIGNAL        (MAX_SYSTEM_SIG+1)  
  993.  
  994. extern STk_sigint_counter;
  995. extern STk_control_C;
  996.  
  997. void      STk_handle_signal(int sig);
  998. PRIMITIVE STk_add_signal_handler(SCM sig, SCM proc);
  999. PRIMITIVE STk_set_signal_handler(SCM sig, SCM proc);
  1000. PRIMITIVE STk_get_signal_handlers(SCM sig);
  1001.  
  1002. void       STk_init_signal(void);
  1003. void       STk_mark_signal_table(void);
  1004.  
  1005. #define STk_disallow_sigint() {STk_sigint_counter += 1;}
  1006. #define STk_allow_sigint()    {STk_sigint_counter -= 1;}
  1007.  
  1008.  
  1009. /*
  1010.   ------------------------------------------------------------------------------
  1011.   ----
  1012.   ---- S L I B . C
  1013.   ----
  1014.   ------------------------------------------------------------------------------
  1015. */
  1016. #ifndef _DEBUG_MALLOC_INC
  1017. void *STk_must_malloc(unsigned long size);
  1018. void *STk_must_realloc(void *ptr, unsigned long size);
  1019. #endif
  1020.  
  1021. double   STk_my_time(void);
  1022.  
  1023. SCM      STk_internal_eval_string(char *s, long err_code, SCM env);
  1024.  
  1025. PRIMITIVE STk_catch(SCM expr, SCM env, int len);
  1026. PRIMITIVE STk_quit_interpreter(SCM retcode);
  1027. PRIMITIVE STk_version(void);
  1028. PRIMITIVE STk_machine_type(void);
  1029. PRIMITIVE STk_library_location(void);
  1030. PRIMITIVE STk_random(SCM n);
  1031. PRIMITIVE STk_set_random_seed(SCM n);
  1032. PRIMITIVE STk_get_internal_info(void);
  1033. PRIMITIVE STk_time(SCM expr, SCM env, int len);
  1034. PRIMITIVE STk_uncode(SCM expr);
  1035. #ifdef SIGSEGV
  1036. PRIMITIVE STk_default_SIGSEGV_handler(void);
  1037. #endif
  1038. void STk_panic TCL_VARARGS_DEF(char *,arg1);
  1039.  
  1040.  
  1041. #define must_malloc  STk_must_malloc
  1042. #define must_realloc STk_must_realloc
  1043.  
  1044.  
  1045. /*
  1046.   ------------------------------------------------------------------------------
  1047.   ----
  1048.   ---- S P O R T . C
  1049.   ----
  1050.   ------------------------------------------------------------------------------
  1051. */
  1052.  
  1053. struct sport_descr {        /* Slot order is important (see port_descr) */
  1054.   FILE *file;
  1055.   int  flags;
  1056. };
  1057.  
  1058.  
  1059. SCM       STk_internal_open_input_string(char *s);
  1060. void       STk_free_string_port(SCM port);
  1061. SCM       STk_internal_read_from_string(SCM port, int *eof, int case_significant);
  1062. PRIMITIVE STk_open_input_string(SCM s);
  1063. PRIMITIVE STk_open_output_string();
  1064. PRIMITIVE STk_get_output_string(SCM port);
  1065. PRIMITIVE STk_input_string_portp(SCM port);
  1066. PRIMITIVE STk_output_string_portp(SCM port);
  1067. PRIMITIVE STk_with_input_from_string(SCM string, SCM thunk);
  1068. PRIMITIVE STk_with_output_to_string(SCM thunk);
  1069. PRIMITIVE STk_read_from_string(SCM str);
  1070.  
  1071. /*
  1072.   ------------------------------------------------------------------------------
  1073.   ----
  1074.   ---- S T K L O S . C
  1075.   ----
  1076.   ------------------------------------------------------------------------------
  1077. */
  1078. #ifdef USE_STKLOS
  1079. #  define STKLOS_VERSION    "2.2b1"
  1080.    PRIMITIVE STk_init_STklos(void);
  1081. #endif
  1082.  
  1083.  
  1084. /*
  1085.   ------------------------------------------------------------------------------
  1086.   ----
  1087.   ---- S T R I N G . C
  1088.   ----
  1089.   ------------------------------------------------------------------------------
  1090. */
  1091. SCM       STk_makestrg(int len, char *init);
  1092.  
  1093. PRIMITIVE STk_stringp(SCM obj);
  1094. PRIMITIVE STk_make_string(SCM len, SCM init_char);
  1095. PRIMITIVE STk_lstring(SCM l, int len);
  1096. PRIMITIVE STk_string_length(SCM str);
  1097.  
  1098. PRIMITIVE STk_string_ref(SCM str, SCM index);
  1099. PRIMITIVE STk_string_set(SCM str, SCM index, SCM value);
  1100.  
  1101. PRIMITIVE STk_streq   (SCM s1, SCM s2);
  1102. PRIMITIVE STk_strless (SCM s1, SCM s2);
  1103. PRIMITIVE STk_strgt   (SCM s1, SCM s2);
  1104. PRIMITIVE STk_strlesse(SCM s1, SCM s2);
  1105. PRIMITIVE STk_strgte  (SCM s1, SCM s2);
  1106.  
  1107. PRIMITIVE STk_streqi   (SCM s1, SCM s2);
  1108. PRIMITIVE STk_strlessi (SCM s1, SCM s2);
  1109. PRIMITIVE STk_strgti   (SCM s1, SCM s2);
  1110. PRIMITIVE STk_strlessei(SCM s1, SCM s2);
  1111. PRIMITIVE STk_strgtei  (SCM s1, SCM s2);
  1112.  
  1113. PRIMITIVE STk_substring(SCM string, SCM start, SCM end);
  1114. PRIMITIVE STk_string_append(SCM l, int len);
  1115. PRIMITIVE STk_string2list(SCM str);
  1116. PRIMITIVE STk_list2string(SCM l);
  1117. PRIMITIVE STk_string_copy(SCM str);
  1118. PRIMITIVE STk_string_fill(SCM str, SCM c);
  1119.  
  1120. PRIMITIVE STk_string_findp(SCM s1, SCM s2);            /* + */
  1121. PRIMITIVE STk_string_index(SCM s1, SCM s2);            /* + */
  1122. PRIMITIVE STk_string_lower(SCM s);                /* + */
  1123. PRIMITIVE STk_string_upper(SCM s);                /* + */
  1124.  
  1125. #define STk_makestring(s) STk_makestrg(strlen(s), (s))
  1126.  
  1127.  
  1128. /*
  1129.   ------------------------------------------------------------------------------
  1130.   ----
  1131.   ---- S Y M B O L . C
  1132.   ----
  1133.   ------------------------------------------------------------------------------
  1134. */
  1135. void       STk_initialize_symbol_table(void);
  1136. void       STk_mark_symbol_table(void);
  1137. void       STk_free_symbol(SCM symbol);
  1138. SCM        STk_global_env2list(void);
  1139. SCM       STk_intern(char *name);
  1140.  
  1141. PRIMITIVE STk_symbolp(SCM x);
  1142. PRIMITIVE STk_symbol2string(SCM symbol);
  1143. PRIMITIVE STk_string2symbol(SCM string);
  1144.  
  1145. #define Intern    STk_intern
  1146.  
  1147. /*
  1148.   ------------------------------------------------------------------------------
  1149.   ----
  1150.   ---- S Y N T A X . C
  1151.   ----
  1152.   ------------------------------------------------------------------------------
  1153. */
  1154. PRIMITIVE STk_syntax_quote     (SCM *pform, SCM env, int len);
  1155. PRIMITIVE STk_syntax_lambda    (SCM *pform, SCM env, int len);
  1156. PRIMITIVE STk_syntax_if        (SCM *pform, SCM env, int len);
  1157. PRIMITIVE STk_syntax_setq      (SCM *pform, SCM env, int len);
  1158. PRIMITIVE STk_syntax_cond      (SCM *pform, SCM env, int len);
  1159. PRIMITIVE STk_syntax_and       (SCM *pform, SCM env, int len);
  1160. PRIMITIVE STk_syntax_or        (SCM *pform, SCM env, int len);
  1161. PRIMITIVE STk_syntax_let       (SCM *pform, SCM env, int len);
  1162. PRIMITIVE STk_syntax_letstar   (SCM *pform, SCM env, int len);
  1163. PRIMITIVE STk_syntax_letrec    (SCM *pform, SCM env, int len);
  1164.  
  1165. PRIMITIVE STk_syntax_begin     (SCM *pform, SCM env, int len);
  1166. PRIMITIVE STk_syntax_delay     (SCM *pform, SCM env, int len);
  1167. PRIMITIVE STk_syntax_quasiquote(SCM *pform, SCM env, int len);
  1168.  
  1169. PRIMITIVE STk_syntax_define    (SCM *pform, SCM env, int len);
  1170.  
  1171. PRIMITIVE STk_while(SCM l, SCM env, int len);
  1172. PRIMITIVE STk_until(SCM l, SCM env, int len);
  1173. PRIMITIVE STk_syntax_extend_env(SCM *pform, SCM env, int len);
  1174. /*
  1175.   ------------------------------------------------------------------------------
  1176.   ----
  1177.   ---- T O P L E V E L . C
  1178.   ----
  1179.   ------------------------------------------------------------------------------
  1180. */
  1181. void STk_toplevel(int argc, char **argv);
  1182.  
  1183. /*
  1184.   ------------------------------------------------------------------------------
  1185.   ----
  1186.   ---- T R A C E . C
  1187.   ----
  1188.   ------------------------------------------------------------------------------
  1189. */
  1190. void       STk_change_value     (SCM var, SCM env);
  1191. void       STk_mark_tracevar_table(void);
  1192. PRIMITIVE STk_trace_var         (SCM var, SCM code);
  1193. PRIMITIVE STk_untrace_var     (SCM var);
  1194.  
  1195. /*
  1196.   ------------------------------------------------------------------------------
  1197.   ----
  1198.   ---- U N I X . C
  1199.   ----
  1200.   ------------------------------------------------------------------------------
  1201. */
  1202.  
  1203. #ifndef WIN32
  1204. #  define ISDIRSEP(ch)      ((ch)=='/')
  1205. #  define ISABSOLUTE(cp) (ISDIRSEP(*cp))
  1206. #  define DIRSEP      '/'
  1207. #  define SDIRSEP       "/"
  1208. #  define PATHSEP     ':'
  1209. #else
  1210. #  define ISDIRSEP(ch)      ((ch)=='\\' || (ch)=='/')
  1211. #  define ISABSOLUTE(cp) (ISDIRSEP(*cp) || \
  1212.              (isalpha(*cp)&&*((cp)+1)==':')&&ISDIRSEP(*((cp)+1)))
  1213. #  define DIRSEP      '\\'
  1214. #  define SDIRSEP       "\\"
  1215. #  define PATHSEP     ';'
  1216. #endif
  1217.  
  1218.  
  1219. void       STk_whence(char *exec, char *path);
  1220. SCM       STk_internal_expand_file_name(char *s);
  1221. SCM       STk_resolve_link(char *path, int count);
  1222. int       STk_is_directory(const char *path);
  1223.  
  1224. PRIMITIVE STk_expand_file_name(SCM s);
  1225. PRIMITIVE STk_canonical_path(SCM str);
  1226. PRIMITIVE STk_getcwd(void);
  1227. PRIMITIVE STk_chdir(SCM s);
  1228. PRIMITIVE STk_getpid(void);
  1229. PRIMITIVE STk_system(SCM com);
  1230. PRIMITIVE STk_getenv(SCM str);
  1231. PRIMITIVE STk_setenv(SCM var, SCM value);
  1232.  
  1233. PRIMITIVE STk_file_is_directoryp(SCM f);
  1234. PRIMITIVE STk_file_is_regularp(SCM f);
  1235. PRIMITIVE STk_file_is_readablep(SCM f);
  1236. PRIMITIVE STk_file_is_writablep(SCM f);
  1237. PRIMITIVE STk_file_is_executablep(SCM f);
  1238. PRIMITIVE STk_file_existp(SCM f);
  1239. PRIMITIVE STk_file_glob(SCM l, int len);
  1240.  
  1241.  
  1242.  
  1243.  
  1244. /*
  1245.   ------------------------------------------------------------------------------
  1246.   ----
  1247.   ---- V E C T O R . C
  1248.   ----
  1249.   ------------------------------------------------------------------------------
  1250. */
  1251. SCM STk_makevect(int len, SCM init);
  1252.  
  1253. PRIMITIVE STk_vectorp(SCM obj);
  1254. PRIMITIVE STk_make_vector(SCM len, SCM init);
  1255. PRIMITIVE STk_vector(SCM l, int len);
  1256. PRIMITIVE STk_vector_length(SCM v);
  1257. PRIMITIVE STk_vector_ref(SCM v, SCM index);
  1258. PRIMITIVE STk_vector_set(SCM v, SCM index, SCM value);
  1259. PRIMITIVE STk_vector2list(SCM v);
  1260. PRIMITIVE STk_list2vector(SCM l);
  1261. PRIMITIVE STk_vector_fill(SCM v, SCM fill);
  1262.  
  1263. PRIMITIVE STk_vector_copy(SCM vect);
  1264. PRIMITIVE STk_vector_resize(SCM vect, SCM size);
  1265. PRIMITIVE STk_sort(SCM obj, SCM test);
  1266.  
  1267.  
  1268. /*
  1269.   ------------------------------------------------------------------------------
  1270.   ----
  1271.   ---- U S E R I N I T . C
  1272.   ----
  1273.   ------------------------------------------------------------------------------
  1274. */
  1275. void STk_user_init(void);
  1276. void STk_user_cleanup(void);
  1277.  
  1278. /*
  1279.   ------------------------------------------------------------------------------
  1280.   ----
  1281.   ---- G L O B A L   V A R I A B L E S 
  1282.   ----
  1283.   ------------------------------------------------------------------------------
  1284. */
  1285.  
  1286. #ifdef STK_MAIN
  1287. #   define Extern
  1288. #else
  1289. #   define Extern extern
  1290. #endif
  1291.  
  1292. /* Remember if we are running the stk or snow interpreter */
  1293. Extern int STk_snow_is_running;
  1294.  
  1295. /* Program name (expanded) */
  1296. Extern char STk_Argv0[MAX_PATH_LENGTH];
  1297.  
  1298. /* Is it an intearctive interpreter? */
  1299. Extern int STk_interactivep;
  1300.  
  1301. /* Scheme booleans #t and #f */
  1302. Extern SCM STk_truth, STk_ntruth;
  1303.  
  1304. /* Scheme () and the undefined value */
  1305. Extern SCM STk_nil, STk_undefined, STk_unbound;
  1306.  
  1307. /* read buffer */
  1308. Extern char *STk_tkbuffer;
  1309. Extern int STk_line_counter;
  1310. Extern SCM STk_current_filename;
  1311.  
  1312. /* Special symbols */
  1313. Extern SCM STk_sym_lambda, STk_sym_quote,STk_sym_dot, STk_sym_imply, 
  1314.               STk_sym_debug, STk_sym_else, STk_sym_quasiquote, 
  1315.            STk_sym_unquote, STk_sym_unquote_splicing, STk_sym_break;;
  1316.  
  1317. /* Dynamic-wind */
  1318. Extern SCM STk_wind_stack;
  1319.  
  1320. /* Global environment */
  1321. Extern SCM STk_globenv;
  1322.  
  1323. /* Library location */
  1324. Extern char *STk_library_path;
  1325.  
  1326.  
  1327. #undef  Extern
  1328. #define Truth       STk_truth
  1329. #define Ntruth      STk_ntruth
  1330. #define NIL      STk_nil
  1331. #define UNBOUND   STk_unbound
  1332. #define UNDEFINED STk_undefined
  1333.  
  1334. #define Sym_lambda      STk_sym_lambda
  1335. #define Sym_quote      STk_sym_quote
  1336. #define Sym_dot      STk_sym_dot
  1337. #define Sym_imply       STk_sym_imply
  1338. #define Sym_debug      STk_sym_debug
  1339. #define Sym_else      STk_sym_else
  1340. #define Sym_quasiquote   STk_sym_quasiquote
  1341. #define Sym_unquote      STk_sym_unquote
  1342. #define Sym_unq_splicing STk_sym_unquote_splicing
  1343. #define Sym_break     STk_sym_break
  1344.     
  1345. #ifdef USE_TK
  1346. /*
  1347.   ------------------------------------------------------------------------------
  1348.   ----
  1349.   ---- T C L - G L U E . C
  1350.   ----
  1351.   ------------------------------------------------------------------------------
  1352. */
  1353. void  STk_init_glue(void);
  1354. SCM   STk_execute_Tcl_lib_cmd(SCM cmd, SCM args, SCM env, int eval_args);
  1355.  
  1356. /*
  1357.  * STk_Stringify permits to transform the string "s" in a valid STk string.
  1358.  * Original string is deallocated if free_original is 1 
  1359.  */
  1360. char *STk_stringify(char *s, int free_original);
  1361. #endif
  1362.  
  1363. #ifdef USE_TK
  1364. /*
  1365.   ------------------------------------------------------------------------------
  1366.   ----
  1367.   ---- T K - U T I L . C
  1368.   ----
  1369.   ------------------------------------------------------------------------------
  1370. */
  1371.  
  1372. PRIMITIVE STk_string2widget(SCM str);
  1373. PRIMITIVE STk_widget2string(SCM widget);
  1374. PRIMITIVE STk_tk_commandp(SCM obj);
  1375. PRIMITIVE STk_widget_name(SCM obj);
  1376. PRIMITIVE STk_get_widget_data(SCM widget);
  1377. PRIMITIVE STk_set_widget_data(SCM widget, SCM value);
  1378. PRIMITIVE STk_widget_environment(SCM widget);
  1379.  
  1380. /*
  1381.   ------------------------------------------------------------------------------
  1382.   ----
  1383.   ---- T K - M A I N . C
  1384.   ----
  1385.   ------------------------------------------------------------------------------
  1386. */
  1387. extern Tcl_Interp *STk_main_interp;    /* Interpreter for this application. */
  1388. extern int Tk_initialized ;        /* 1 when Tk is fully initialized */
  1389.  
  1390. void Tk_main(int synchronize, char *name, char *fileName, char *Xdisplay,
  1391.          char *geometry);
  1392.  
  1393. #endif
  1394.  
  1395. #ifdef __cplusplus
  1396. };
  1397. #endif
  1398. #endif /* ifndef _STK_H */
  1399.